home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / JARexx / RexxVars.f < prev    next >
Encoding:
Text File  |  1992-01-25  |  4.6 KB  |  271 lines
  1. \ RVI for JForth
  2. \ translated by Martin Kees
  3. \ 5/30/91
  4. \  SetValue    equ    -$54
  5. \  StrcpyN    equ    -$10E
  6. \  CurrentEnv    equ    -$6C
  7. \  Strlen    equ    -$120
  8. \  CloseLibrary    equ    -$19E
  9. \  FreeSpace    equ    -$78
  10. \  GetSpace    equ    -$72
  11. \  OpenLibrary    equ    -$228
  12. \  IsRexxMsg    equ    -$A8
  13. \  FetchValue    equ    -$48
  14. \  IsSymbol    equ    -$66
  15. \  EnterSymbol    equ    -$42
  16.  
  17. \ 00001 PLB 1/24/92 Changed PC relative reference to REXSYS_NAME for Clone
  18. \ 00002 PLB 1/25/92 Fixed wierd 78(PC) error recovery in <SETREXXVAR>
  19.  
  20. anew task-rexxvars.f
  21.  
  22. \ internal stubs used by RexxVar interface
  23. ASM Stubb1D2
  24.     move.l    a1,d1
  25.     beq.s    1$
  26.     moveq    #1,d0
  27.     and.b    6(a1),d0
  28.     bne.s    1$
  29.     move.w    4(a1),d0
  30.     addq.l    #8,d0
  31.     addq.l    #1,d0
  32.     jsr    $-78(a6)     \ freespace
  33. 1$:    rts
  34. end-code
  35.  
  36. ASM Stubb19E
  37.     movem.l    d0/a1,-(rp)
  38.     addq.l    #8,d0
  39.     addq.l    #1,d0
  40.     jsr    $-72(a6)    
  41.     movem.l    (rp)+,d0/a1
  42.     beq.s    1$
  43.     move.l    a0,-(rp)
  44.     clr.l    (a0)
  45.     move.w    d0,4(a0)
  46.     move.b    #2,6(a0)
  47.     clr.b    8(a0,d0.l)
  48.     addq.w    #8,a0
  49.     jsr    $-10E(a6)    
  50.     move.l    (rp)+,a0
  51.     move.b    d0,7(a0)
  52. 1$:    move.l    a0,d0
  53. end-code
  54.  
  55. ASM Stubb134
  56.     movem.l    d2/d3/a2/a3,-(rp)
  57.     moveq    #0,d2
  58.     moveq    #0,d3
  59.     jsr    $-120(a6)    
  60.     move.l    a0,a1
  61.     move.l    a4,a0
  62.     bsr    Stubb19E
  63.     move.l    d0,a2
  64.     beq.s    180$
  65.     lea    8(a2),a1
  66.     move.w    4(a2),d0
  67.     move.l    a1,d1
  68. 154$:    cmp.b    #$2E,(a1)+
  69.     dbeq.w    d0,154$
  70.     bne.s    16$
  71.     exg    d1,a1
  72.     sub.l    a1,d1
  73.     move.l    a2,d3
  74.     move.l    a4,a0
  75.     move.l    d1,d0
  76.     bsr    Stubb19E
  77.     move.l    d0,a2
  78.     beq.s    180$
  79. 16$:    lea    8(a2),a0
  80.     jsr    $-66(a6)    
  81.     cmp.w    4(a2),d1
  82.     beq.s    182$
  83.     moveq    #$28,d2
  84.     bra.s    182$
  85. 180$:    moveq    #3,d2
  86. 182$:    tst.l    d2
  87.     beq.s    192$
  88.     move.l    a4,a0
  89.     move.l    a2,a1
  90.     bsr    Stubb1D2
  91.     move.l    a4,a0
  92.     move.l    d3,a1
  93.     bsr    Stubb1D2
  94. 192$:    move.l    a2,a1
  95.     move.l    d3,d1
  96.     move.l    d2,d0
  97.     movem.l    (rp)+,d2/d3/a2/a3
  98. end-code
  99.  
  100.  
  101.  
  102. ASM Stubb1EC
  103.     move.l    a3,-(rp)
  104.     move.l    $14(a2),a3
  105.     move.l    a2,(a1)
  106.     movem.l    $FC(a3),d0/d1
  107.     movem.l    a0/a1,$FC(a3)
  108.     movem.l    d0/d1,4(a1)
  109.     move.l    (rp)+,a3
  110. end-code
  111.  
  112. ASM Stubb20A
  113.         move.l    (a0),a1
  114.     move.l    $14(a1),a1
  115.     movem.l    4(a0),d0/d1
  116.     movem.l    d0/d1,$FC(a1)
  117. end-code
  118.  
  119. \ Use this instead of string past RTS for Clone
  120. create RXSLIB_NAME ," rexxsyslib.library"  RXSLIB_NAME $>0
  121.  
  122. ASM <CheckRexxMsg>  (  --- )
  123.     movem.l    d2/a2/a6,-(rp)
  124.     move.l    a0,a2
  125.     move.l    4,a6
  126.     lea    [RXSLIB_NAME HERE - 2-](pc),a1    \ point to 0" rexxsyslib.library"
  127.     moveq    #0,d0
  128.     jsr    $-228(a6)    
  129.     move.l    d0,d2
  130.     beq.s    48$
  131.     move.l    d2,a1
  132.     jsr    $-19E(a6)    
  133.     moveq    #0,d0
  134.     cmp.l    $18(a2),d2
  135.     bne.s    48$
  136.     move.l    $14(a2),d1
  137.     beq.s    48$
  138.     move.l    a2,a0
  139.     move.l    d2,a6
  140.     jsr    $-A8(a6)    
  141. 48$:    tst.l    d0
  142.     movem.l    (rp)+,d2/a2/a6
  143. end-code
  144.  
  145. ASM <GetRexxVar> ( -- )
  146.     movem.l    a2-a4/a6,-(rp)
  147.     move.l    a0,a2
  148.     move.l    a1,a3
  149.     bsr    <CheckRexxMsg>
  150.     beq.s    9$
  151.     move.l    $18(a2),a6
  152.     move.l    $14(a2),a0
  153.     jsr    $-6C(a6)    
  154.     move.l    a0,a4
  155.     move.l    a3,a0
  156.     bsr    Stubb134
  157.     bne.s    8$
  158.     move.l    a4,a0
  159.     move.l    d1,d0
  160.     moveq    #0,d1
  161.     jsr    $-48(a6)
  162.     addq.w    #8,a1
  163.     moveq    #0,d0
  164.     tst.l    d1
  165.     beq.s    8$
  166.     sub.l    a1,a1
  167.     bra.s    8$
  168. 9$:    moveq    #10,d0
  169. 8$:    tst.l    d0
  170.     movem.l    (rp)+,a2-a4/a6
  171. end-code
  172.  
  173. \ This next routine is only for error returns from <SETREXXVAR>
  174. \ in case of low memory.  It is a wierd kludge for Clone needed
  175. \ because of some wierd error handling in ARexx.  It is copied
  176. \ from the rear of <SETREXXVAR>
  177. ASM <SRV.NOMEM>  ( -- , DO NOT CALL THIS )
  178.         moveq    #3,d0
  179.         move.l    rp,a0
  180.         move.l    d0,-(rp)
  181.         bsr    Stubb20A
  182.         move.l    (rp)+,d0
  183.         lea    12(rp),rp
  184.         movem.l    (rp)+,d2-d7/a2-a6
  185. END-CODE    
  186.  
  187. ASM <SetRexxVar> ( -- )
  188.     movem.l    d2-d7/a2-a6,-(rp)
  189.     lea    -12(rp),rp
  190.     move.l    a0,a2    \ rexxmsg
  191.     move.l    a1,a3    \ rexxvar
  192.     move.l    d0,a5
  193.     move.l    d1,d3
  194.     bsr    <CheckRexxMsg>
  195.     beq.s    116$
  196.     move.l    $18(a2),a6
  197.     lea    [' <SRV.NOMEM> HERE - 2-](pc),a0   \ set error jump
  198.     move.l    rp,a1
  199.     bsr    Stubb1EC
  200.     cmp.l    #$FFFF,d3
  201.     bgt.s    11$
  202.     move.l    $14(a2),a0
  203.     jsr    $-6C(a6)    
  204.     move.l    a0,a4
  205.     move.l    a3,a0
  206.     bsr    Stubb134
  207.     bne.s    120$
  208.     move.l    a1,a2
  209.     move.l    d1,d2
  210.     move.l    a4,a0
  211.     move.l    d2,d0
  212.     jsr    $-42(a6)    
  213.     move.l    d0,d4
  214.     move.l    a4,a0
  215.     move.l    a5,a1
  216.     move.l    d3,d0
  217.     bsr    Stubb19E
  218.     beq.s    1110$
  219.     move.l    a4,a0
  220.     move.l    d0,a1
  221.     move.l    d4,d0
  222.     jsr    $-54(a6)    
  223.     moveq    #0,d0
  224.     bra.s    120$
  225. \
  226. 116$:    moveq    #10,d0
  227.     bra.s    12$
  228. \
  229. 1110$:  moveq    #3,d0
  230.     bra.s    120$
  231. \
  232. 11$:    moveq    #9,d0
  233. 120$:    move.l    rp,a0
  234.     move.l    d0,-(rp)
  235.     bsr    Stubb20A
  236.     move.l    (rp)+,d0
  237. 12$:    lea    12(rp),rp
  238.     movem.l    (rp)+,d2-d7/a2-a6
  239. end-code    
  240.  
  241. \ All of the following use standard JForth relative addresses
  242. ASM CheckRexxMsg ( rxmsg --- Flag )
  243.     move.l tos,a0
  244.     adda.l org,a0
  245.     bsr    <CheckRexxMsg>
  246.     move.l d0,tos
  247. end-code    
  248.  
  249. ASM GetRexxVar ( rxmsg 0$variable -- 0$value error )
  250.     move.l tos,a1
  251.     adda.l org,a1
  252.     move.l (dsp),a0
  253.     adda.l org,a0
  254.     bsr    <GetRexxVar>
  255.     move.l d0,tos
  256.     sub.l  org,a1
  257.     move.l a1,(dsp)
  258. end-code    
  259.  
  260. ASM SetRexxVar ( rxmsg 0$var 0$val length -- error )
  261.     move.l tos,d1
  262.     move.l (dsp)+,d0
  263.     add.l  org,d0
  264.     move.l (dsp)+,a1
  265.     adda.l org,a1
  266.     move.l (dsp)+,a0
  267.     adda.l org,a0
  268.     bsr    <SetRexxVar>
  269.     move.l d0,tos
  270. end-code    
  271.